COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE LOGGER
C00003 00003	Data area
C00005 00004	Initialization
C00008 00005	RFC server
C00010 00006	Log the RFC
C00012 00007	 Got the files open, now print/file info about the RFC
C00014 00008	Subroutines
C00015 ENDMK
C⊗;
TITLE LOGGER
SUBTTL Definitions

; Mark Crispin, SU-AI, February 1978

; AC definitions

A=1 ? B=2 ? X=10 ? P=17

; I/O channel definitions

DSI==16 ? DSO==17

; Assembly switches

IFNDEF PDLLEN,PDLLEN==50		; length of pushdown stack

; SAIL system bit definitions

INTIMS==000020,,			; RFC arrived
RFCS==  200000,,			; RFC sent
RFCR==  100000,,			; RFC received
CLSS==  040000,,			; CLS sent
CLSR==  020000,,			; CLS received
LGONCE==004000,,			; here already
REAPRV==040000,,			; read anywhere
WRTPRV==020000,,			; write anywhere
ACWPRV==000040,,			; patch core
LUPPRV==000001,,			; local user
SUBTTL Data area

CORBEG==.

PDL:	BLOCK PDLLEN			; pushdown stack
NOPRVP:	BLOCK 1				; -1 → cretin privileges have screwed us
FILBLK:	BLOCK 4				; LOOKUP/ENTER block
DSIBF:	BLOCK 3				; disk input buffer
DSOBF:	BLOCK 3				; disk output buffer

COREND==.-1

; SWAP UUO block

SWPBLK:	'DSK,,				; device name
SVRNAM:	'RFC,,				; program name
	14				; phantom job
	0				; normal core size and start address
	'NETSYS				; file directory
	'NETSYS				; PPN to be run under

; Pointers into the monitor

FFLNK:	0				; first free link
; Pntrs are indexed up by 1, so RH is addr-1
LNKTAB:	(X)				; host-link number
IMPDDB:	(X)				; address of DDB
IMPLS:	(X)				; local socket number
IMPFS:	(X)				; foreign socket number
IMPSTB:	(X)				; link status
SUBTTL Initialization

LOGGER:	JFCL
	RESET
	SETZB CORBEG
	MOVE A,[CORBEG,,CORBEG+1]
	BLT A,COREND

; Diddle privileges

	GETPRV
	TLO (REAPRV\WRTPRV\ACWPRV\LUPPRV); want REA+WRT+ACT+LUP
	SETPRV
	TLC (REAPRV\WRTPRV\ACWPRV\LUPPRV)	
	TLCN (REAPRV\WRTPRV\ACWPRV\LUPPRV)	
	 JRST LOGGR1
	SETOM NOPRVP			; screwed by privileges!
	OUTSTR [ASCIZ/Un/]
	TLNE (REAPRV\WRTPRV\ACWPRV)	
	 OUTSTR [ASCIZ/der/]
	OUTSTR [ASCIZ/privileged /]
LOGGR1:	OUTSTR [ASCIZ/LOGGER started
/]

; Check for others

	MOVE [SIXBIT/[LOGR]/]
	SETNAM
	NAMEIN
	 JRST [	SETZ
		SETNAM
		OUTSTR [ASCIZ/There is another logger!/]
		EXIT]
	MOVE P,[PDL(-PDLLEN)]

; Get some I/O channels

	INIT DSI, ? 'DSK,, ? DSIBF
	 JRST 4,.-3			; INIT snarfs its args funny
	INIT DSO, ? 'DSK,, ? DSOBF,,
	 JRST 4,.-3

; Snarf up some monitor symbols

	MOVEI [.RSQZ 0,FFLNK ? 0]
	.SYML 
	 JRST 4,.-1
	ADDI 400000
	MOVEM FFLNK
	IRPS SYM,,LNKTAB IMPDDB IMPLS IMPFS IMPSTB
	 MOVEI [.RSQZ 0,SYM ? 0]
	 .SYML 
	  JRST 4,.-1
	 ADDI 377777
	 HRRM SYM
	TERMIN

; Map the monitor in

	MOVSI 377776
	SETPR2
	 JRST 4,.-1

; Set up interrupts

	MOVEI [DISMIS]
	MOVEM JOBAPR
	MOVSI (INTIMS)
	INTENB
	JRST RFCSER			; scan through at least once

; Really a sleeper

SLEEPR:	IWAIT
SUBTTL RFC server

; Scan monitor tables for an interesting RFC

RFCSER:	MOVE X,@FFLNK			; set up pointer to links
CHKLNK:	SKIPE @IMPDDB			; ignore links with a DDB
	 JRST NXTLNK
	MOVE @IMPSTB			; get status of this link
	TLNE (RFCR)			; somebody listening?
	 TLNE (RFCS\CLSR\CLSS\LGONCE)	; link already been munged?
	  JRST NXTLNK
	MOVSI (LGONCE)
	SKIPN NOPRVP
	 IORM @IMPSTB			; flag we've looked at the link

; Got an RFC with nobody serving it.  Make sure it is interesting.

	MOVE @IMPLS			; get socket for this link
	CAIGE 1000			; public socket?
	 TRNN 1				; and heterosocketual?
	  JRST NXTLNK

; Save the info about this connection on the stack

	PUSH P,@IMPFS
	PUSH P,@IMPLS
	PUSH P,@LNKTAB

; Convert the socket number to sixbit

	LSHC -6				; separate 3 digits by three bits
	LSH 3
	LSHC 3
	LSH 3
	LSHC 3
	ADDI '000			; form sixbit socket number

; Now fire up the server

	HRRM SVRNAM
	MOVEI SWPBLK
	SWAP				; fire up the server
; (continued on next page)
SUBTTL Log the RFC

	JUMPE [	OUTSTR [ASCIZ/Ign RFC/]
		JRST CONMSG]		; couldn't fire up phantom
	OUTSTR [ASCIZ/RFC j=/]		; server job
	PUSHJ P,DECOUT
CONMSG:	DATE
	IDIVI 12.*31.			; month/days in A
	IDIVI A,31.
	MOVEI (A)
	ROTC A,-3			; form 0M0M0D0D00 in A
	LSH A,-3
	ROTC A,-3
	LSH A,-3
	LSHC -3
	LSH A,-3
	LSHC -3
	LSH A,-3
	ADD A,[SIXBIT/0101/]		; convert to sixbit/MMDD/
	MOVEM A,FILBLK
	MOVSI A,'RFC
	MOVEM A,FILBLK+1
	MOVE A,[SIXBIT/NETACT/]
	SETZM FILBLK+2
	MOVEM A,FILBLK+3
	ENTER DSO,FILBLK
	 JRST [	MOVEI [	'CTY,,
			[ASCIZ/LOGGER can't ENTER statistics file!  Find MRC.
/]]
		TTYMES
		 JRST 4,.-1
		JRST 4,.-1]
	HLLZS FILBLK+1
	MOVE A,[SIXBIT/NETACT/]
	MOVEM A,FILBLK+3
	LOOKUP DSI,FILBLK
	 JRST [	HRRZ FILBLK+1
		JUMPE MAKFIL
		MOVEI [	'CTY,,
			[ASCIZ/LOGGER can't LOOKUP statistics file!  Find MRC.
/]]
		TTYMES
		 JRST 4,.-1
		JRST 4,.-1]
CPYLUP:	PUSHJ P,FBIN
	 JRST [	CLOSE DSI,
		JRST MAKFIL]
	PUSHJ P,FBOUT
	JRST CPYLUP
; Got the files open, now print/file info about the RFC

MAKFIL:	LDB [101017,,]
	PUSHJ P,FNOUT
	MOVEI <" >
	PUSHJ P,FBOUT
	OUTSTR [ASCIZ/, hst=/]		; host number
	LDB [101017,,]
	PUSHJ P,OCTOUT
	OUTSTR [ASCIZ/, lnk=/]		; link number
	POP P,
	ANDI 377
	PUSHJ P,DECOUT
	MOVE (P)
	PUSHJ P,FNOUT
	MOVEI ↑M
	PUSHJ P,FBOUT
	MOVEI ↑J
	PUSHJ P,FBOUT
	OUTSTR [ASCIZ/, lsk=/]		; local socket number
	POP P,
	PUSHJ P,OCTOUT
	OUTSTR [ASCIZ/, fsk=/]		; foreign socket number
	POP P,
	PUSHJ P,OCTOUT
	OUTSTR [ASCIZ/.
/]
	CLOSE DSO,
	HLRZ JOBSA
	MOVEM JOBFF			; reset JOBFF

; Check next link

NXTLNK:	SOJG X,CHKLNK			; try next link
	JRST SLEEPR			; done scanning
SUBTTL Subroutines

; File I/O

FBIN:	SOSG DSIBF+2
	 IN DSI,
	  CAIA
	   POPJ P,
	ILDB DSIBF+1
	JUMPE FBIN
	AOS (P)
	POPJ P,

FNOUT:	IDIVI 8.
	PUSH P,A
	SKIPE
	 PUSHJ P,FNOUT
	POP P,
	ADDI "0
;	JRST FBOUT

FBOUT:	SOSG DSOBF+2
	 OUT DSO,
	  CAIA
	   JRST 4,.-1
	IDPB DSOBF+1
	POPJ P,

; Decimal/octal print routine

DECOUT:	SKIPA B,[10.]			; decimal print
OCTOUT:	 MOVEI B,8.			; octal print
NUMOUT:	IDIVI (B)
	PUSH P,A
	SKIPE
	 PUSHJ P,NUMOUT
	POP P,
	ADDI "0
	OUTCHR
	POPJ P,

END LOGGER